home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 March - Disc 1 / Macworld (1999-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / sqlMode.tcl < prev    next >
Encoding:
Text File  |  1998-12-08  |  4.7 KB  |  129 lines  |  [TEXT/ALFA]
  1.  
  2. #############################################################################
  3. #   FILE: sql.tcl
  4. #----------------------------------------------------------------------------
  5. # AUTHOR:     Joel D. Elkins
  6. #     of      New Media, Inc.
  7. #             200 South Meridian, Ste. 220
  8. #             Indianapolis, IN 46225
  9. #
  10. # internet:   jdelkins@iquest.net  (preferred)
  11. # compuserve: 72531,314
  12. # AOL:        jdelkins
  13. #
  14. #   Copyright © 1994-1995 by Joel D. Elkins
  15. #   All rights reserved.
  16. #############################################################################
  17. #
  18. #  Alpha mode for SQL and Oracle's PL/SQL programming language
  19. #  Converts SQL and PL/SQL keywords to uppercase on the fly and colorizes
  20. #
  21. #############################################################################
  22. # HISTORY
  23. #                  
  24. # modified who rev reason
  25. # -------- --- --- ------ 
  26. # 7/29/94  JDE 1.0 Original 
  27. # 2/8/95   JDE 1.1 Added electUpper for tab, cr, and ';'
  28. #############################################################################
  29.  
  30. alpha::mode SQL 1.0.1 dummySQL { *.sql *.SQL *.pkg} electricSemicolon
  31.  
  32. proc dummySQL {} {}
  33.  
  34. #############################################################################
  35. # PL/SQL mode by Joel D. Elkins
  36. #############################################################################
  37.  
  38. newPref    v    wordBreak            {(\$)?\w+}    SQL
  39. newPref    v    prefixString        {--}    SQL
  40. newPref    f    wordWrap            {0}    SQL
  41. newPref    v    funcExpr            {(PROCEDURE|FUNCTION)[ \t]+(\w+)}    SQL
  42. newPref    v    wordBreakPreface    {[^a-zA-Z0-9_\$]} SQL
  43.  
  44. bind '\ ' {electUpper "\ "} "SQL"
  45. bind '\t' {electUpper "\t"} "SQL"
  46. bind '\r' {electUpper "\r"} "SQL"
  47. bind '\;' {electUpper "\;"} "SQL"
  48.  
  49.  
  50. set sqlKeywords {
  51.     ABORT ACCEPT ACCESS ALTER AND ARRAY ARRAYLEN AS ASSERT AT AVG BEGIN BETWEEN BODY
  52.     CASE COLUMNS COMMIT CONSTANT COUNT CREATE CURSOR DECLARE DEFAULT DEFINITION
  53.     DELETE DESC DISPOSE DISTINCT DO DROP ELSE ELSIF END ENTRY EXCEPTION EXISTS EXIT
  54.     FALSE FETCH FOR FROM FUNCTION GOTO IF IN INSERT INTERSECT INTO IS LIKE LOOP MAX MIN
  55.     MINUS MOD NEW OF ON OPEN OR OUT PACKAGE PARTITION POSITIVE PRAGMA PRIVATE
  56.     PROCEDURE PUBLIC RANGE RECORD REM REPLACE RETURN ROLLBACK ROWTYPE RUN SAVEPOINT
  57.     SELECT SET SIZE START STDDEV SUM THEN TO TYPE UNION UNIQUE UPDATE USE VALUES
  58.     VARIANCE WHEN WHERE WHILE WITH XOR
  59. }
  60. ###    Just colorize uppercase keywords
  61. #    abort accept access alter and array arraylen as assert at avg begin between body
  62. #    case columns commit constant count create cursor declare default definition
  63. #    delete desc dispose distinct do drop else elsif end entry exception exists exit
  64. #    false fetch for from function goto if in insert intersect into is like loop max min
  65. #    minus mod new of on open or out package partition positive pragma private
  66. #    procedure public range record rem replace return rollback rowtype run savepoint
  67. #    select set size start stddev sum then to type union unique update use values
  68. #    variance when where while with xor
  69. ###
  70. regModeKeywords -e {--} -b {/*} {*/} -c red -k blue SQL $sqlKeywords
  71. unset sqlKeywords
  72. #================================================================================
  73.  
  74. catch {unset plSqlKeywords}
  75.  
  76. lappend plSqlKeywords \
  77.     abort accept access alter and array arraylen as assert at avg begin between body \
  78.     case columns commit constant count create cursor declare default definition \
  79.     delete desc dispose distinct do drop else elsif end entry exception exists exit \
  80.     false fetch for from function goto if in insert intersect into is like loop max min \
  81.     minus mod new of on open or out package partition positive pragma private \
  82.     procedure public range record rem replace return rollback rowtype run savepoint \
  83.     select set size start stddev sum then to type union unique update use values \
  84.     variance when where while with xor
  85.  
  86.  
  87. proc electUpper {char} {
  88.     global plSqlKeywords
  89.     
  90.     set a [getPos]
  91.     backwardWord
  92.     set b [getPos]
  93.     
  94.     #make sure we're not in a comment
  95.     beginningOfLine
  96.     set commentSearch {(^[ \t]*rem[ \t]+)|(^[ \t]*REM[ \t]+)|--}
  97.     if {[catch {search -s -r 1 -f 1 -l $b -- $commentSearch [getPos]}] != 0} {
  98.         #if not, make the word uppercase if it's a keyword
  99.         set cmd [getText $b $a]
  100.         goto $b
  101.         if {[lsearch -exact $plSqlKeywords [string tolower $cmd]] >= 0} {
  102.             upcaseWord
  103.         }
  104.     }
  105.     goto $a
  106.     if { 0 == [string compare $char "\r"] } {
  107.         bind::CarriageReturn
  108.     } else {
  109.         insertText $char
  110.     }
  111. }
  112.  
  113. proc SQL::MarkFile {} {
  114.     global SQLmodeVars
  115.     set pos 0
  116.     while {![catch {search -s -f 1 -r 1 -m 0 -i 0 $SQLmodeVars(funcExpr) $pos} res]} {
  117.         set start [lindex $res 0]
  118.         set end [lindex $res 1]
  119.         set text [lindex [getText $start $end] 1]
  120.         set pos $end
  121.         set inds($text) "$start $end"
  122.     }
  123.     
  124.     if {[info exists inds]} {
  125.         foreach f [lsort [array names inds]] {
  126.             setNamedMark $f [lineStart [lineStart [lindex $inds($f) 0]] - 1] [lindex $inds($f) 0] [lindex $inds($f) 1]
  127.         }
  128.     }
  129. }